home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Loadstar 30
/
030.d81
/
klondike solitai
(
.txt
)
< prev
next >
Wrap
Commodore BASIC
|
2022-08-26
|
5KB
|
129 lines
10 gosub910:clr:poke53280,12:poke53281,1
20 printchr$(142)"[147][144]"spc(12)"klondike solitaire"
30 printspc(11)"shuffling the deck..."
40 poke56334,peek(56334)and254:poke1,peek(1)and251:b=12288
50 c=53248:fori=0to2047:pokei+b,peek(i+c):next:poke1,peek(1)or4
60 poke56334,peek(56334)or1
70 poke53272,(peek(53272)and240)+12
80 dim c$(52),d(7,25),p(7),nu(7),u(52),b(27),dk(27),ck(52,2)
90 data a,2,3,4,5,6,7,8,9,@,j,q,"k" : b$=" [157][157][157][157] [157][157][157][157] [157][157][157][157]"
100 n$="" : q$(1)="[144] [193]":q$(2)=" [211]":q$(3)=" [218]":q$(4)="[144] [216]"
110 fori=1to12:forj=1to2:ck(i,j)=14*j+i+(j=2):next:next
120 fori=14to25:forj=0to1:ck(i,j+1)=39*j+i-12:next:next
130 fori=27to38:forj=0to1:ck(i,j+1)=39*j+i-25:next:next:ck(0,0)=-1
140 ck(0,1)=-1:fori=40to51:forj=1to2:ck(i,j)=14*j+i+(j=2)-39:next:next
150 fori=1to4:restore:forj=1to13:readc$
160 c$((i-1)*13+j)="[207][183][183][208][157][157][157][157][165]"+q$(i)+"[157][157]"+c$+"[144][167][157][157][157][157][204][175][175][186][157][157][157][157]":next:next
170 fori=0to7:reada:pokeb+i,a:next:data 158,146,146,146,146,146,158,0
180 fori=1to52:u(i)=0:next:fori=1to27:b(i)=0:dk(i)=0:next:dp=0:print"[147]"
190 fori=1to7:p(i)=i:forj=1toi
200 x=int(rnd(0)*52)+1:ifu(x)then200
210 u(x)=-1:d(i,j)=x
220 next:nu(i)=i-1:next:fori=1to4:nf(i)=0:next
230 x=int(rnd(0)*52)+1:ifu(x)then230
240 u(x)=-1 : dk(dp+1)=x : dp=dp+1 : if dp<24 then goto230
250 c$(0)=b$:nd=24
260 print"[147] klondike solitaire"
270 print"spades hearts diamonds clubs bone";
280 fori=1to4:ifnf(i)=0thenprintspc(9);:goto300
290 printc$(13*(i-1)+nf(i))"[145][145][145] ";
300 next:printc$(b(1))
310 print" 1 ";:fori=2to7:print" "i;:next:print"[145]"
320 printspc(6);:fori=2to7
330 ifnu(i)thenprint" "chr$(nu(i)+48)" [146][144]";:goto350
340 print spc(4);
350 ifi<7thenprint" ";
360 next
370 fori=1to7:np=0:b=nu(i):ifp(i)=0thenprint"";:goto420
380 ifp(i)-b>5thenb=p(i)-4:printc$(d(i,nu(i)+1))"[145]";:np=1
390 forj=b+1top(i):printc$(d(i,j))"[145]";:next:print"";:np=np+p(i)-b
400 ifnp>1thenfork=2tonp:print"[145][145]";:next
410 ifi<7thenprint"[145][145][145] ";
420 next
430 print"number of cards in deck:"nd"[144]"
440 u=0:fori=1to4:u=u+nf(i):next:ifu<52then460
450 print""spc(40)" you have won !!":fort=1to2000:next:nw=-1:run20
460 ifdk(1)>0orb(1)>0then490
470 u=0:fori=1to7:u=u+nu(i):next:ifu>0then490
480 print" your victory is inevitable!!"
490 w$="":print"[144][146]play: 1-7, b)one d)raw q)uit n)ew ->";
500 poke198,0:wait198,1:getw$:w=val(w$):if w>0 and w<8 thenprintw$:goto580
510 nw=0:ifw$="n"thenw$="q":nw=1
515 ifw$<>"b"andw$<>"d"andw$<>"q"then500
517 printw$
520 on -(w$="b")-2*(w$="d")-3*(w$="q")+1 goto490,530,690,760
530 gosub810:q=b(1):ifw$<>""then560
540 ifc1=ck(q,1)orc1=ck(q,2)thenp(l)=p(l)+1:d(l,p(l))=b(1):goto860
550 goto870
560 if b(1)-1 = 13*(s-1)+nf(s) then nf(s)=nf(s)+1 : goto860
570 goto870
580 w=val(w$):ifp(w)=0then870
590 w=val(w$):gosub810:q=d(w,p(w)):ifw$<>""or(w=l)then650
600 fori=p(w)tonu(w)+1step-1:b=d(w,i):ifck(b,1)<>c1andck(b,2)<>c1then640
610 forj=ito p(w):d(l,p(l)+j-i+1)=d(w,j):next
620 p(l)=p(l)+p(w)-i+1:p(w)=i-1:p(w)=-(p(w)>=0)*p(w):p(l)=-(p(l)>=0)*p(l)
630 goto670
640 next : goto870
650 ifq-1<>13*(s-1)+nf(s)then870
660 nf(s)=nf(s)+1:p(w)=p(w)-1
670 ifp(w)=nu(w)andnu(w)>0thennu(w)=nu(w)-1
680 goto260
690 if nd>0 then720
700 forx=1to24:ifb(x)<>0thennext
710 fori=1tox-1:dk(i)=b(x-i):b(x-i)=0:next:nd=x-1
720 for p=24to4step-1:b(p)=b(p-3):next:fori=1to3:b(i)=dk(4-i):next
730 nd=nd-3:for p=1to24:dk(p)=dk(p+3):next:ifnd<>abs(nd)thennd=.
740 if b(3)>0 then g=2: if b(2)>0 then g=1: if b(1)>0 then260
750 fori=1to27-g:b(i)=b(i+g):next:goto260
760 print:print"are you sure (y/n)?";:wait198,1:getok$:printok$:ifok$<>"y"then260
770 ifnwthenrun20
780 open15,8,15,"r0:hello connect=hello connect":input#15,er:close15
790 print"[147]";:ifer<>63thenend
800 poke53272,21:load"hello connect",8
810 print"where to: column 1-7, s,h,d,c [157][157]>";:getw$:printw$
820 l=val(w$) : if l>0 and l<8 then c1=d(l,p(l)) : w$="" : return
830 s=-(w$="s")-2*(w$="h")-3*(w$="d")-4*(w$="c")
840 if s=0 thenprint"[145]";:goto810
850 return
860 for p=1to26:b(p)=b(p+1):next:goto260
870 print"you trying to cheat, podner?":
880 poke54276,.:poke54296,15:poke54273,24:poke54272,75:poke54277,28:poke54278,10
890 poke54276,33
900 form=1to2500:next:poke198,0:goto260
910 pn$="[203][204][207][206][196][201][203][197] [211][207][204][201][212][193][201][210][197]":an$="[194][217]: [202][193][201][205] [193][206][196][210][197][215] [194][193][201][204][197][217]"
920 bo=11:sc=1:cl=06:c1=12:c2=00:c3=12:c4=00:c5=00:c6=06:c7=011
930 poke53272,21
940 poke53280,bo:poke53281,sc:print"[147]";:goto1060
950 poke646,c1:print" [164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164]"
960 poke646,c2:print" [165] [204][207][193][196][211][212][193][210] [208][210][197][211][197][206][212][211]: [167]"
970 poke646,c1:print" [163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163]"
980 poke646,c6:print""tab(20-len(pn$)/2);pn$
990 poke646,c7:print""tab(20-len(an$)/2);an$
1000 poke646,c5:print""tab(13)"[195][207][208][217][210][201][199][200][212] 1986"
1010 printtab(9)"[195][207][205][205][207][196][207][210][197] [208][213][194][204][201][195][193][212][201][207][206][211]"
1020 poke646,c3:print" [164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164]"
1030 poke646,c4:print" [165] [167]"
1040 poke646,c3:print" [163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][146]";
1050 poke198,.:goto1150
1060 poke646,cl
1070 print" [172][162][162][162][162][162][162][162][162][162][162][162][162][162][162][162][162][162][162][162][162][162][162][162][162][162][162][162][162][162][162][162][162][162][162][162][162][187]"
1080 fora=1to3:gosub1260:next
1090 gosub1260:print"[145][183][183][183][183][183][183][183][183][183][183][183][183][183][183][183][183][183][183][183][183][183][183][183][183][183][183][183][183][183][183][183][183][183][183][183][183]"
1100 fora=1to16:gosub1260:next
1110 print"[145][175][175][175][175][175][175][175][175][175][175][175][175][175][175][175][175][175][175][175][175][175][175][175][175][175][175][175][175][175][175][175][175][175][175][175][175]"
1120 fora=1to3:gosub1260:next
1130 print" [188][162][162][162][162][162][162][162][162][162][162][162][162][162][162][162][162][162][162][162][162][162][162][162][162][162][162][162][162][162][162][162][162][162][162][162][162][146][190]";
1140 poke53280,bo:poke53281,sc:goto950
1150 print"";
1160 poke646,c2:print"[165][208]ress the [[211][208][193][195][197] [194][193][210]] to continue.[167]"
1170 fora=1to100
1180 geta$:ifa$=" "ora$="[160]"thenreturn
1190 next
1200 print"";
1210 print"[165] [167]"
1220 fora=1to100
1230 geta$:ifa$=" "ora$="[160]"thenreturn
1240 next
1250 goto1150
1260 print" [161][146][161]":return